home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / generic-sc.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  57.9 KB  |  1,740 lines
  1. ;;; generic-sc.el --- generic interface to source control systems
  2.  
  3. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: devin@lucid.com
  6. ;; Keywords: tools, unix
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Synched up with: Not in FSF.
  25.  
  26. ;; The generic interface provide a common set of functions that can be
  27. ;; used to interface with a source control system like SCCS, RCS or
  28. ;; CVS.  
  29. ;; 
  30. ;; You chose which source control system to use by calling sc-mode
  31. ;; 
  32. ;; The module is based on the sccs.el mode of Eric S. Raymond
  33. ;; (eric@snark.thyrsus.com) which was distantly derived from an rcs
  34. ;; mode written by Ed Simpson ({decvax, seismo}!mcnc!duke!dukecdu!evs)
  35. ;; in years gone by and revised at MIT's Project Athena.
  36.  
  37. ;;; This can be customized by the user
  38. (defvar sc-diff-command '("diff")
  39.   "*The command/flags list to be used in constructing diff commands.")
  40.  
  41. ;; Duplicated from pcl-cvs.
  42. (defvar cvs-program "cvs"
  43.   "*The command name of the cvs program.")
  44.  
  45. (defvar sc-mode-expert ()
  46.   "*Treat user as expert; suppress yes-no prompts on some things.")
  47.  
  48. (defvar sc-max-log-size 510
  49.   "*Maximum allowable size of a source control log message.")
  50.  
  51. (defvar sc-ccase-comment-on '(checkout checkout-dir checkin-dir rename
  52.                        new-brtype new-branch checkin-merge
  53.                        create-label label-sources)
  54.   "*Operations on which comments would be appreciated.
  55. We check the values checkout, checkout-dir, checkin-dir,
  56. rename, new-brtype, new-branch, create-label,
  57. and label-sources as symbols.")
  58.  
  59. (defvar sc-ccase-reserve nil
  60.   "Whether to reserve checkouts or not. By default, this is nil - don't.
  61. Other values are t - do, and anything else, eg. 'ask - ask.")
  62.  
  63. ;; default keybindings
  64. (defvar sc-prefix-map (lookup-key global-map "\C-xv"))
  65. (if (not (keymapp sc-prefix-map))
  66.     (progn
  67.       (setq sc-prefix-map (make-sparse-keymap))
  68.       (define-key global-map "\C-xv" sc-prefix-map)
  69.       (define-key sc-prefix-map "v" 'sc-next-operation)
  70.       (define-key sc-prefix-map "=" 'sc-show-changes)
  71.       (define-key sc-prefix-map "l" 'sc-show-history)
  72.       (define-key sc-prefix-map "p" 'sc-visit-previous-revision)
  73.       (define-key sc-prefix-map "u" 'sc-revert-file)
  74.       (define-key sc-prefix-map "d" 'sc-list-registered-files)
  75.       (define-key sc-prefix-map "\C-d" 'sc-update-directory)
  76.       (define-key sc-prefix-map "\C-r" 'sc-rename-file)
  77.       ))
  78.  
  79.  
  80. ;;; The user does not change these
  81. (defvar sc-generic-name ""
  82.   "Name of the source control system used.  Is displayed in the modeline.")
  83.  
  84. (defvar sc-mode-line-string ()
  85.   "Revision number to show in the mode line")
  86.  
  87. (defvar sc-generic-log-buf ()
  88.   "Buffer for entering log message")
  89.  
  90. (defvar sc-log-entry-keymap ()
  91.   "Additional keybindings used when entering the log message")
  92.  
  93. (defvar sc-can-hack-dir ()
  94.   "Does the SC system allow users to play directly with directories")
  95.  
  96. (defvar sc-ccase-mfs-prefixes ()
  97.   "Prefixes known to the system to be MFS ... ignore all others")
  98.  
  99. (defmacro sc-chmod (perms file)
  100.   (list 'call-process "chmod" nil nil nil perms file))
  101.  
  102. (defmacro error-occurred (&rest body)
  103.   (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
  104.  
  105.  
  106. ;;; User level functions
  107. (defun sc-next-operation (verbose)
  108.   "Do the next logical source-control operation on the file in the current buffer.
  109. The current subdirectory must be under source control.
  110.    If the file is not already registered with the source control, this registers it 
  111. and checks it out.
  112.    If the file is registered and not locked by anyone, this checks it out.
  113.    If the file is registered and locked by the calling user, this pops up a
  114. buffer for creation of a log message, then checks the file in.
  115. A read-only copy of the changed file is left in place afterwards.
  116.    If the file is registered and locked by someone else, an error message is
  117. returned indicating who has locked it."
  118.   (interactive "P")
  119.   (if (not buffer-file-name)
  120.       (error "There is no file associated with buffer %s" (buffer-name)))
  121.   (let* (revision
  122.      (file buffer-file-name)
  123.      (lock-info (sc-lock-info file))
  124.      (sc-generic-log-buf
  125.       (get-buffer-create (format "*%s-Log*" sc-generic-name)))
  126.      (err-msg nil))
  127.     (if (eq lock-info 'na)
  128.     (error "The file associated with buffer %s is not registered" (buffer-name)))
  129.     
  130.     ;; if file is not registered register it and set lock-info to show it's not locked
  131.     (if (not lock-info)
  132.     (progn
  133.       (sc-register-file verbose)
  134.       (setq lock-info (list () ()))))
  135.     
  136.     (cond ((not (car lock-info))
  137.        ;; if there is no lock on the file, assert one and get it
  138.        (sc-check-out file t)
  139.        (revert-buffer nil t)
  140.        (sc-mode-line))
  141.           
  142.       ((and (not (equal sc-generic-name "CCase"))
  143.            (not (equal (car lock-info) (user-login-name))))
  144.        ;; file is locked by someone else
  145.        (error "Sorry, %s has that file locked." (car lock-info)))
  146.  
  147.       (t 
  148.        ;; OK, user owns the lock on the file 
  149.        ;; if so, give user a chance to save before delta-ing.
  150.        (if (and (buffer-modified-p)
  151.             (or
  152.              sc-mode-expert
  153.              (y-or-n-p (format "%s has been modified. Write it out? "
  154.                        (buffer-name)))))
  155.            (save-buffer))
  156.            
  157.        (setq revision (car (cdr lock-info)))
  158.            
  159.        ;; user may want to set nonstandard parameters
  160.        (if verbose
  161.            (if (or sc-mode-expert
  162.                (y-or-n-p 
  163.             (format "revision: %s  Change revision level? "
  164.                 revision)))
  165.            (setq revision (read-string "New revision level: "))))
  166.            
  167.        ;; OK, let's do the delta
  168.        (let ((buffer (sc-temp-buffer)))
  169.          (if (save-window-excursion
  170.            ;; this excursion returns t if the new version was saved OK
  171.            (pop-to-buffer buffer)
  172.            (erase-buffer)
  173.            (set-buffer-modified-p nil)
  174.            (sc-log-entry-mode)
  175.            (message 
  176.             "Enter log message. Type C-c C-c when done, C-c ? for help.")
  177.            (prog1
  178.                (and (not (error-occurred (recursive-edit)))
  179.                 (not (error-occurred
  180.                   (sc-check-in file revision
  181.                            (buffer-string)))))
  182.              (setq buffer-file-name nil)
  183.              (bury-buffer buffer)))
  184.            
  185.          ;; if the save went OK do some post-checking
  186.          (if (buffer-modified-p)
  187.              (error
  188.               "Checked-in version of file does not match buffer!")
  189.            (revert-buffer nil t)
  190.            (sc-mode-line)
  191.            (run-hooks 'sc-check-in-ok))))))))
  192.  
  193. (defun sc-insert-last-log ()
  194.   "Insert the log message of the last check in at point."
  195.   (interactive)
  196.   (insert-buffer sc-generic-log-buf))
  197.  
  198. (defun sc-abort-check-in ()
  199.   "Abort a source control check-in command."
  200.   (interactive)
  201.   (if (or sc-mode-expert (y-or-n-p "Really Abort Check-in? "))
  202.       (progn
  203.     (delete-window)
  204.     (abort-recursive-edit))))
  205.  
  206. (defun sc-log-exit ()
  207.   "Proceed with checkin with the contents of the current buffer as message."
  208.   (interactive)
  209.   (if (< (buffer-size) sc-max-log-size)
  210.       (progn
  211.     (copy-to-buffer sc-generic-log-buf (point-min) (point-max))
  212.     (exit-recursive-edit)
  213.     (delete-window))
  214.     (goto-char sc-max-log-size)
  215.     (error
  216.      "Log must be less than %d characters. Point is now at char %d."
  217.      sc-max-log-size (point))))
  218.  
  219.  
  220. ;;; Functions to look at the edit history
  221. (defun sc-show-changes (arg)
  222.   "Compare the version being edited with the last checked-in revision.
  223. With a prefix argument prompt for revision to compare with."
  224.   (interactive "P")
  225.   ;; check that the file is not modified
  226.   (if (and (buffer-modified-p)
  227.        (or
  228.         sc-mode-expert
  229.         (y-or-n-p (format "%s has been modified. Write it out? "
  230.                   (buffer-name)))))
  231.       (save-buffer))
  232.   (let* ((revision (and arg (read-string "Revision to compare against: ")))
  233.      (file buffer-file-name)
  234.      (name (file-name-nondirectory file))
  235.      (old (sc-get-version-in-temp-file file revision))
  236.      (buffer (sc-temp-buffer))
  237.      status)
  238.     (save-excursion
  239.       (set-buffer buffer)
  240.       (erase-buffer)
  241.       (setq default-directory (file-name-directory file))
  242.       (setq status
  243.         (apply 'call-process (car sc-diff-command) () t ()
  244.            (append (cdr sc-diff-command) (list old) (list file)))))
  245.     (if (not (or (eq 0 status) (eq 1 status))) ; see man diff.1
  246.     (progn
  247.       (display-buffer buffer)
  248.       (error "diff FAILED")))
  249.     (delete-file old)
  250.     (save-excursion
  251.       (set-buffer buffer)
  252.       (goto-char (point-min))
  253.       (if (equal (point-min) (point-max))
  254.       (insert
  255.        (format "No changes to %s since last update."
  256.            (file-name-nondirectory file)))
  257.     (insert "==== Diffs for " file "\n")
  258.     (insert "==== ")
  259.     (mapcar '(lambda (i) (insert i " ")) sc-diff-command)
  260.     (insert name "<" (or revision "current") ">" " " name "\n\n")))
  261.     (display-buffer buffer)))
  262.  
  263. (defun sc-show-revision-changes ()
  264.   "Prompt for a revision to diff against."
  265.   (interactive)
  266.   (sc-show-changes 4))
  267.  
  268. (defun sc-version-diff-file (file rel1 rel2)
  269.   "For FILE, report diffs between two revisions REL1 and REL2 of it."
  270.   (interactive "fFile: \nsOlder version: \nsNewer version: ")
  271.   (if (string-equal rel1 "") (setq rel1 nil))
  272.   (if (string-equal rel2 "") (setq rel2 nil))
  273.   (let ((buffer (sc-temp-buffer)))
  274.     (set-buffer buffer)
  275.     (erase-buffer)
  276.     (let ((v1 (sc-get-version-in-temp-file file rel1))
  277.       (v2 (if rel2 (sc-get-version-in-temp-file file rel2) file)))
  278.       (and v1
  279.        v2
  280.        (unwind-protect
  281.            (apply 'call-process (car sc-diff-command) nil t t
  282.               (append (cdr sc-diff-command) (list v1) (list v2)))))
  283.       (condition-case () (delete-file v1) (error nil))
  284.       (if rel2
  285.       (condition-case () (delete-file v2) (error nil)))
  286.       (set-buffer-modified-p nil)
  287.       (goto-char (point-min))
  288.       (if (equal (point-min) (point-max))
  289.       (message
  290.        (format "No changes to %s between %s and %s." file rel1 rel2))
  291.     (display-buffer buffer)))))
  292.  
  293. (defun sc-show-history ()
  294.   "List the edit history of the current buffer."
  295.   (interactive)
  296.   (let ((file buffer-file-name))
  297.     (if (not file)
  298.     (error "There is no file associated with buffer %s" (buffer-name)))
  299.     (if (not (sc-lock-info file))
  300.     (error "The file is not registered in the source control system"))
  301.     (let ((buffer (sc-temp-buffer)))
  302.       (save-excursion
  303.     (set-buffer buffer)
  304.     (erase-buffer)
  305.     (sc-history file)
  306.     (goto-char (point-min)))
  307.       (display-buffer buffer))))
  308.  
  309. (defun sc-visit-previous-revision (revision)
  310.   "Show a previous revision of the current file"
  311.   (interactive "sShow previous revision number: ")
  312.   (let ((file buffer-file-name))
  313.     (if (not file)
  314.     (error "There is no file associated with buffer %s" (buffer-name)))
  315.     (let ((other-file (sc-get-version-in-temp-file file revision))
  316.       (buffer-name (concat (file-name-nondirectory file)
  317.                    "<" sc-generic-name " " revision ">")))
  318.       (pop-to-buffer (get-buffer-create buffer-name))
  319.       (erase-buffer)
  320.       (insert-file other-file)
  321.       ;; get the same major mode as the original file
  322.       (setq buffer-file-name file)
  323.       (normal-mode)
  324.       (setq buffer-file-name ())
  325.       (set-buffer-modified-p ())
  326.       (toggle-read-only)
  327.       (delete-file other-file))))
  328.  
  329. (defun sc-revert-file ()
  330.   "Revert the current buffer's file back to the last saved version."
  331.   (interactive)
  332.   (let ((file buffer-file-name))
  333.     (if (y-or-n-p (format "Revert file %s to last checked-in revision?" file))
  334.     (progn
  335.       (sc-revert file)
  336.       (revert-buffer nil t)
  337.       (sc-mode-line)))))
  338.  
  339. ;; Functions to get directory level information
  340.  
  341. (defun sc-list-all-locked-files (arg)
  342.   "List all files currently locked under the revision control system.
  343. With prefix arg list only the files locked by the user."
  344.   (interactive "P")
  345.   (let* ((locker (and arg (user-login-name)))
  346.      (buffer (sc-tree-walk 'sc-list-file-if-locked locker)))
  347.     (save-excursion
  348.       (set-buffer buffer)
  349.       (goto-char (point-min))
  350.       (if (= (point-min) (point-max))
  351.       (insert "No files locked ")
  352.     (insert "Files locked "))
  353.       (if locker
  354.       (insert "by " locker " "))
  355.       (insert "in " default-directory "\n\n"))
  356.     (display-buffer buffer)))
  357.       
  358. (defun sc-list-locked-files ()
  359.   "List all files currently locked by me"
  360.   (interactive)
  361.   (sc-list-all-locked-files 4))
  362.  
  363. (defun sc-list-registered-files ()
  364.   "List all files currently registered under the revision control system."
  365.   (interactive)
  366.   (let ((buffer (sc-tree-walk 'sc-list-file)))
  367.     (save-excursion
  368.       (set-buffer buffer)
  369.       (if (= (point-min) (point-max))
  370.       (insert "No files registered in " sc-generic-name
  371.           " in " default-directory)
  372.     (goto-char (point-min))
  373.     (insert "Files registered in " sc-generic-name " in " default-directory
  374.         "\n\n")))
  375.     (display-buffer buffer)))
  376.        
  377. (defun sc-update-directory ()
  378.   "Updates the current directory by getting the latest copies of the files"
  379.   (interactive)
  380.   (save-some-buffers)
  381.   (let ((buffer (sc-tree-walk 'sc-update-file)))
  382.     (save-excursion
  383.       (set-buffer buffer)
  384.       (goto-char (point-min))
  385.       (if (= (point-min) (point-max))
  386.       (insert "No files needed to be updated in " default-directory "\n\n")
  387.     (insert "Files updated in " default-directory "\n\n")))
  388.     (display-buffer buffer)))
  389.  
  390. ;; Miscellaneous other entry points
  391.  
  392. (defun sc-register-file (verbose)
  393.   "Register the file visited by the current buffer into source control.
  394. Prefix argument register it under an explicit revision number."
  395.   (interactive "P")
  396.   (let ((file buffer-file-name))
  397.     (if (not file)
  398.     (error "There is no file associated with buffer %s" (buffer-name)))
  399.     (let ((lock-info (sc-lock-info file))
  400.       (revision ()))
  401.       (if lock-info
  402.       (error "This file is already registered into %s" sc-generic-name))
  403.       ;; propose to save the file if it's modified
  404.       (if (and (buffer-modified-p)
  405.            (or
  406.         sc-mode-expert
  407.         (y-or-n-p (format "%s has been modified. Write it out? "
  408.                   (buffer-name)))))
  409.       (save-buffer))
  410.       ;; get the revision number
  411.       (if verbose
  412.       (setq revision (read-string "Initial Revision Number: ")))
  413.       (sc-register file revision)
  414.       (revert-buffer nil t)
  415.       (sc-mode-line))))
  416.  
  417. (defun sc-rename-file (old new)
  418.   "Rename a file, taking its source control archive with it."
  419.   (interactive "fOld name: \nFNew name: ")
  420.   (let ((owner (sc-locking-user old)))
  421.     (if (and owner (not (string-equal owner (user-login-name))))
  422.     (error "Sorry, %s has that file checked out" owner)))
  423.   (if sc-can-hack-dir
  424.       (rename-file old new t))
  425.   (sc-rename old new))
  426.  
  427. (defun sc-rename-this-file (new)
  428.   "Rename the file of the current buffer, taking its source control archive with it"
  429.   (interactive "FNew name: ")
  430.   (if (and (buffer-modified-p)
  431.        (y-or-n-p (format "%s has been modified. Write it out? "
  432.                  (buffer-name))))
  433.       (save-buffer))
  434.   (sc-rename-file buffer-file-name new)
  435.   (let ((old-buffer (current-buffer))
  436.     (new-buffer (find-file-noselect new)))
  437.     (set-window-buffer (selected-window) new-buffer)
  438.     (pop-to-buffer (current-buffer))
  439.     (bury-buffer old-buffer)))
  440.  
  441.  
  442. ;;; Mode independent functions 
  443. ;;; All those sc-... functions FUNCALL the corresponding sc-generic-... function.  
  444. ;;; The variables are set to functions that do the SCCS, RCS or CVS commands 
  445. ;;; depending on the mode chosen.
  446.  
  447. (defvar sc-generic-lock-info ()
  448.   "Function to implement sc-lock-info")
  449.  
  450. (defun sc-lock-info (file)
  451.   "Return a list of the current locker and current locked revision for FILE.
  452. Returns NIL if FILE is not registered in the source control system.
  453. Return (NIL NIL) if FILE is registered but not locked.
  454. Return (locker revision) if file is locked."
  455.   (funcall sc-generic-lock-info file))
  456.  
  457.  
  458. (defvar sc-generic-register ()
  459.   "Function to implement sc-register")
  460.  
  461. (defun sc-register (file revision)
  462.   "Register FILE under source control with initial revision REVISION."
  463.   (funcall sc-generic-register file revision))
  464.  
  465.  
  466. (defvar sc-generic-check-out ()
  467.   "Function to implement sc-check-out")
  468.  
  469. (defun sc-check-out (file lockp)
  470.   "Checks out the latest version of FILE.  
  471. If LOCKP is not NIL, FILE is also locked."
  472.   (funcall sc-generic-check-out file lockp))
  473.  
  474.  
  475. (defvar sc-generic-get-version ()
  476.   "Function to implement sc-get-version")
  477.  
  478. (defun sc-get-version (file buffer revision)
  479.   "Insert a previous revison of FILE in BUFFER.  
  480. REVISION is the revision number requested."
  481.   (funcall sc-generic-get-version file buffer revision))
  482.  
  483.  
  484. (defvar sc-generic-check-in ()
  485.   "Function to implement sc-check-in")
  486.  
  487. (defun sc-check-in (file revision message)
  488.   "Check in FILE with revision REVISION.
  489. MESSAGE is a string describing the changes."
  490.   (funcall sc-generic-check-in file revision message))
  491.  
  492.  
  493. (defvar sc-generic-history ()
  494.   "Function to implement sc-history")
  495.  
  496. (defun sc-history (file)
  497.   "Insert the edit history of FILE in the current buffer."
  498.   (funcall sc-generic-history file))
  499.  
  500.  
  501. (defvar sc-generic-tree-list ()
  502.   "Function to implement sc-tree-list")
  503.  
  504. (defun sc-tree-list ()
  505.   "List in the current buffer the files registered in the source control system"
  506.   (funcall sc-generic-tree-list))
  507.   
  508.  
  509. (defvar sc-generic-new-revision-p ()
  510.   "Function to implement sc-new-revision-p")
  511.  
  512. (defun sc-new-revision-p (file)
  513.   "True if a new revision of FILE was checked in since we last got a copy of it"
  514.   (funcall sc-generic-new-revision-p file))
  515.  
  516.  
  517. (defvar sc-generic-revert ()
  518.   "Function to implement sc-revert")
  519.  
  520. (defun sc-revert (file)
  521.   "Cancel a check out of FILE and get back the latest checked in version"
  522.   (funcall sc-generic-revert file))
  523.  
  524.  
  525. (defvar sc-generic-rename ()
  526.   "Function to implement sc-rename")
  527.  
  528. (defun sc-rename (old new)
  529.   "Rename the source control archives for OLD to NEW"
  530.   (funcall sc-generic-rename old new))
  531.  
  532.  
  533. (defvar sc-menu ()
  534.   "Menu to use")
  535.   
  536.  
  537. ;;; Utilities functions
  538. (defun sc-do-command (buffer message command file sc-file &rest flags)
  539.   "Execute a command, notifying the user and checking for errors."
  540.   (setq file (expand-file-name file))
  541.   (message (format "Running %s on %s..." message file))
  542.   (let ((status
  543.      (save-excursion
  544.        (set-buffer (get-buffer-create buffer))
  545.        (erase-buffer)
  546.        (setq flags (append flags (and file (list sc-file))))
  547.        (setq flags (delq () flags))
  548.        (let ((default-directory (file-name-directory (or file "./"))))
  549.          (eq (apply 'call-process command nil t nil flags) 0)))))
  550.     (if status
  551.     (message (format "Running %s...OK" message))
  552.       (save-excursion
  553.     (set-buffer buffer)
  554.     (goto-char (point-min))
  555.     (insert command)
  556.     (mapcar '(lambda (i) (insert " " i)) flags)
  557.     (insert "\n\n")
  558.     (goto-char (point-min)))
  559.       (display-buffer buffer)
  560.       (error (format "Running %s...FAILED" message)))))
  561.  
  562. (defun sc-enter-comment ()
  563.   "Enter a comment. Return it as a string."
  564.   (let ((buffer (sc-temp-buffer)))
  565.     (setq sc-generic-log-buf
  566.       (get-buffer-create (format "*%s-Log*" sc-generic-name)))
  567.     (save-window-excursion
  568.       ;; this excursion returns t if the new version was saved OK
  569.       (pop-to-buffer buffer)
  570.       (erase-buffer)
  571.       (set-buffer-modified-p nil)
  572.       (sc-log-entry-mode)
  573.       (message 
  574.        "Enter log message. Type C-c C-c when done, C-c ? for help.")
  575.       (prog1
  576.       (and (not (error-occurred (recursive-edit)))
  577.            (let ((bs (buffer-string)))
  578.          (if (> (length bs) 0) bs)))
  579.     (setq buffer-file-name nil)
  580.     (bury-buffer buffer)))))
  581.  
  582. (defun sc-locking-user (file)
  583.   "Return the login name of the locker of FILE.  Return nil if FILE is not locked"
  584.   (car (sc-lock-info file)))
  585.  
  586. (defun sc-locked-revision (file)
  587.   "Return the revision number currently locked for FILE, nil if FILE is not locked."
  588.   (car (cdr (sc-lock-info file))))
  589.  
  590. (defun sc-mode-line ()
  591.   "Set the mode line for the current buffer.
  592. FILE is the file being visited."
  593.   (let* ((file buffer-file-name)
  594.      (lock-info (sc-lock-info file)))
  595.     ;; ensure that the global mode string is not NIL
  596.     (or global-mode-string (setq global-mode-string '("")))
  597.     ;; ensure that our variable is in the global-mode-string
  598.     (or (memq 'sc-mode-line-string global-mode-string)
  599.     (setq global-mode-string
  600.           (append global-mode-string '(sc-mode-line-string))))
  601.     (make-local-variable 'sc-mode-line-string)
  602.     (setq sc-mode-line-string
  603.       (cond ((or
  604.           (eq lock-info 'na)
  605.           (null lock-info))     ())
  606.         ((null (car lock-info))
  607.          (format " <%s:>" sc-generic-name))
  608.         ((equal (car lock-info) (user-login-name))
  609.          (format " <%s: %s>" sc-generic-name (car (cdr lock-info))))
  610.         (t
  611.          (format " <%s: %s>" sc-generic-name (car lock-info)))))))
  612.  
  613. (defun sc-temp-buffer ()
  614.   "Return a temporary buffer to use for output"
  615.   (get-buffer-create (format "*%s*" sc-generic-name)))
  616.  
  617. (defun sc-tree-walk (func &rest args)
  618.   "Apply FUNC to the files registered in the source control system.
  619. FUNC is passed the file path and ARGS."
  620.   (let* ((buffer-name (format "*%s directory*" sc-generic-name))
  621.      (buffer (get-buffer-create buffer-name))
  622.      (dir default-directory)
  623.      files)
  624.     ;; recreate the directory buffer in the right directory
  625.     (save-excursion
  626.       (set-buffer buffer)
  627.       (erase-buffer)
  628.       (setq default-directory dir)
  629.       ;; get a list of all the registered files
  630.       (sc-tree-list)
  631.       ;; remove the "not found" messages
  632.       (goto-char (point-min))
  633.       (while (search-forward "not found" () t)
  634.     (beginning-of-line 1)
  635.     (kill-line 1))
  636.       ;; check if any file is listed
  637.       (if (= (point-min) (point-max))
  638.       (error "No registered files under %s" default-directory))
  639.       ;; build the list of files
  640.       (goto-char (point-min))
  641.       (setq files ())
  642.       (while (not (eobp))
  643.     (let ((file
  644.            (buffer-substring (point) (progn (end-of-line) (point)))))
  645.       (setq files (cons file files)))
  646.     (forward-line 1))
  647.       (setq files (nreverse files))
  648.       ;; let the function output information in the buffer
  649.       (erase-buffer))
  650.     (display-buffer buffer)
  651.     ;; apply the function
  652.     (save-excursion
  653.       (set-buffer buffer)
  654.       (while files
  655.     (apply func (car files) args)
  656.     (setq files (cdr files)))
  657.       buffer)))
  658.   
  659. (defun sc-get-version-in-temp-file (file revision)
  660.   "For the given FILE, retrieve a copy of the version with given REVISION.
  661. The text is retrieved into a tempfile.  Return the tempfile name."
  662.   (let* ((oldversion
  663.       (make-temp-name
  664.        (concat (or (ccase-protect-expanded-name revision) "current")
  665.            "-"
  666.            (file-name-nondirectory file)
  667.            "-")))
  668.      (vbuf (get-buffer-create oldversion)))
  669.     (sc-get-version file vbuf revision)
  670.     (save-excursion
  671.       (set-buffer vbuf)
  672.       (write-region (point-min) (point-max) oldversion t 0))
  673.     (kill-buffer vbuf)
  674.     (sc-chmod "-w" oldversion)
  675.     oldversion))
  676.  
  677. ;; Functions used to get directory level information
  678.  
  679. (defun sc-insert-file-lock-info (file lock-info)
  680.   (insert (car lock-info) ":" (car (cdr lock-info)))
  681.   (indent-to-column 16 1)
  682.   (insert (file-name-nondirectory file) "\n"))
  683.   
  684. (defun sc-list-file-if-locked (file &optional arg)
  685.    "List all files underneath the current directory matching a prefix type."
  686.    (let ((lock-info (sc-lock-info file)))
  687.      (if (and lock-info
  688.           (car lock-info)
  689.           (or (null arg) (equal arg (car lock-info))))
  690.      (progn
  691.        (sc-insert-file-lock-info file lock-info)
  692.        (sit-for 0)))))
  693.  
  694. (defun sc-list-file (file)
  695.   (let ((lock-info (sc-lock-info file)))
  696.     (cond ((eq lock-info 'na)
  697.        (indent-to-column 16 1)
  698.        (insert (file-name-nondirectory file) "\n"))
  699.       ((car lock-info)
  700.        (sc-insert-file-lock-info file lock-info))
  701.       ((sc-new-revision-p file)
  702.        (insert "needs update")
  703.        (indent-to-column 16 1)
  704.        (insert (file-name-nondirectory file) "\n"))
  705.       (t
  706.        (indent-to-column 16 1)
  707.        (insert (file-name-nondirectory file) "\n")))
  708.     (sit-for 0)))
  709.  
  710. ;;; Function to update one file from the archive
  711. (defun sc-update-file (file)
  712.   "get the latest version of the file if a new one was checked-in"
  713.   (if (sc-new-revision-p file)
  714.       (let ((file-name (file-name-nondirectory file)))
  715.     ;; get the latest copy
  716.     (rename-file (sc-get-version-in-temp-file file nil) file t)
  717.     (let ((b (get-file-buffer file)))
  718.       (if b
  719.           (save-excursion
  720.         (set-buffer b)
  721.         (revert-buffer nil t)
  722.         (sc-mode-line))))
  723.     ;; show the file was updated
  724.     (insert "updated")
  725.     (indent-to-column 16 1)
  726.     (insert file-name "\n")
  727.     (sit-for 0))))
  728.  
  729. ;; Set up key bindings for use while editing log messages
  730.  
  731. (if sc-log-entry-keymap
  732.     nil
  733.   (setq sc-log-entry-keymap (make-sparse-keymap))
  734.   (define-key sc-log-entry-keymap "\C-ci" 'sc-insert-last-log)
  735.   (define-key sc-log-entry-keymap "\C-c\C-i" 'sc-insert-last-log)
  736.   (define-key sc-log-entry-keymap "\C-ca" 'sc-abort-check-in)
  737.   (define-key sc-log-entry-keymap "\C-c\C-a" 'sc-abort-check-in)
  738.   (define-key sc-log-entry-keymap "\C-c\C-c" 'sc-log-exit)
  739.   (define-key sc-log-entry-keymap "\C-x\C-s" 'sc-log-exit))
  740.  
  741. (defvar sc-mode-hook nil
  742.   "*Function or functions to run on entry to sc-mode.")
  743.  
  744. (defvar sc-mode ()
  745.   "The currently active source control mode.  Use M-x sc-mode to set it")
  746.  
  747. ;;;###autoload
  748. (defun sc-mode (system)
  749.   "Toggle sc-mode.
  750. SYSTEM can be sccs, rcs or cvs.
  751. Cvs requires the pcl-cvs package.
  752.  
  753. The following commands are available
  754. \\[sc-next-operation]    perform next logical source control operation on current file
  755. \\[sc-show-changes]    compare the version being edited with an older one
  756. \\[sc-version-diff-file]    compare two older versions of a file
  757. \\[sc-show-history]        display change history of current file
  758. \\[sc-visit-previous-revision]    display an older revision of current file
  759. \\[sc-revert-file]        revert buffer to last checked-in version
  760. \\[sc-list-all-locked-files]        show all files locked in current directory
  761. \\[sc-list-locked-files]        show all files locked by you in current directory
  762. \\[sc-list-registered-files]        show all files under source control in current directory
  763. \\[sc-update-directory]        get fresh copies of files checked-in by others in current directory
  764. \\[sc-rename-file]        rename the current file and its source control file
  765.  
  766.  
  767. While you are entering a change log message for a check in, sc-log-entry-mode
  768. will be in effect.
  769.  
  770. Global user options:
  771.     sc-diff-command    A list consisting of the command and flags
  772.             to be used for generating context diffs.
  773.     sc-mode-expert    suppresses some conformation prompts,
  774.             notably for delta aborts and file saves.
  775.     sc-max-log-size    specifies the maximum allowable size
  776.             of a log message plus one.
  777.  
  778.  
  779. When using SCCS you have additional commands and options
  780.  
  781. \\[sccs-insert-headers]        insert source control headers in current file
  782.  
  783. When you generate headers into a buffer using \\[sccs-insert-headers],
  784. the value of sc-insert-headers-hook is called before insertion. If the
  785. file is recognized a C or Lisp source, sc-insert-c-header-hook or
  786. sc-insert-lisp-header-hook is called after insertion respectively.
  787.  
  788.     sccs-headers-wanted    which %-keywords to insert when adding
  789.             headers with C-c h
  790.     sccs-insert-static    if non-nil, keywords inserted in C files
  791.             get stuffed in a static string area so that
  792.             what(1) can see them in the compiled object code.
  793.  
  794. When using CVS you have additional commands
  795.  
  796. \\[sc-cvs-update-directory]    update the current directory using pcl-cvs
  797. \\[sc-cvs-file-status]        show the CVS status of current file
  798. "
  799.   (interactive
  800.    (if sc-mode
  801.        '(())
  802.      (list
  803.       (intern
  804.     (read-string "Turn on source control mode on for: " "SCCS")))))
  805.   (cond ((eq system ())
  806.      (remove-hook 'find-file-hooks 'sc-mode-line)
  807.      (delete-menu-item (list sc-generic-name))
  808.      (remove-hook 'activate-menubar-hook 'sc-sensitize-menu)
  809.      (setq sc-mode ()))
  810.     (sc-mode
  811.      (sc-mode ())
  812.      (sc-mode system))
  813.     (t
  814.      (setq system (intern (upcase (symbol-name system))))
  815.      (let ((f (intern (format "sc-set-%s-mode" system))))
  816.        (if (not (fboundp f))
  817.            (error
  818.         "No source control interface for \"%s\".  \
  819. Please use SCCS, RCS, CVS, or Atria."
  820.         system)
  821.          (funcall f)
  822.          (add-hook 'find-file-hooks 'sc-mode-line)
  823.          (add-menu '() sc-generic-name sc-menu)
  824.          (add-hook 'activate-menubar-hook 'sc-sensitize-menu)
  825.          (run-hooks 'sc-mode-hook)
  826.          (setq sc-mode system))))))
  827.  
  828. (defun sc-log-entry-mode ()
  829.   "Major mode for editing log message.
  830.  
  831. These bindings are available when entering the log message
  832. \\[sc-log-exit]        proceed with check in, ending log message entry
  833. \\[sc-insert-last-log]        insert log message from last check-in
  834. \\[sc-abort-check-in]        abort this check-in
  835.  
  836. Entry to the change-log submode calls the value of text-mode-hook, then
  837. the value sc-log-entry-mode-hook.
  838. "
  839.   (interactive)
  840.   (set-syntax-table text-mode-syntax-table)
  841.   (use-local-map sc-log-entry-keymap)
  842.   (setq local-abbrev-table text-mode-abbrev-table)
  843.   (setq major-mode 'sc-log-entry-mode)
  844.   (setq mode-name "Source Control Change Log Entry")
  845.   (run-hooks 'text-mode-hook 'sc-log-entry-mode-hook))
  846.  
  847.  
  848.  
  849. ;;; SCCS specific part
  850.  
  851. ;; Find a reasonable default for the SCCS bin directory
  852. (defvar sccs-bin-directory
  853.   (cond ((file-executable-p "/usr/sccs/unget") "/usr/sccs")
  854.     ((file-executable-p "/usr/bin/unget") "/usr/bin")
  855.     ((file-directory-p "/usr/sccs") "/usr/sccs")
  856.     ((file-directory-p "/usr/bin/sccs") "/usr/bin/sccs")
  857.     (t "/usr/bin"))
  858.   "*Directory where to find the sccs executables")
  859.  
  860. (defvar sccs-headers-wanted '("\%\W\%")
  861.   "*SCCS header keywords to be inserted when sccs-insert-header is executed.")
  862.  
  863. (defvar sccs-insert-static t
  864.   "*Insert a static character string when inserting source control headers in C mode.
  865. Only relevant for the SCCS mode.")
  866.  
  867. ;; Vars the user doesn't need to know about.
  868.  
  869. (defvar sccs-log-entry-mode nil)
  870. (defvar sccs-current-major-version nil)
  871.  
  872. ;; Some helper functions
  873.  
  874. (defun sccs-name (file &optional letter)
  875.   "Return the sccs-file name corresponding to a given file."
  876.   (if (null file)
  877.       ()
  878.     (let ((expanded-file (expand-file-name file)))
  879.       (format "%sSCCS/%s.%s"
  880.           (concat (file-name-directory expanded-file))
  881.           (or letter "s")
  882.           (concat (file-name-nondirectory expanded-file))))))
  883.  
  884. (defun sccs-lock-info (file)
  885.   "Lock-info method for SCCS.  See sc-generic-lock-info"
  886.   (let ((sccs-file (sccs-name file "s"))
  887.     (lock-file (sccs-name file "p")))
  888.     (cond ((or (null file) (not (file-exists-p sccs-file)))
  889.        ())
  890.       ((not (file-exists-p lock-file))
  891.        (list () ()))
  892.       (t
  893.        (save-excursion
  894.          (set-buffer (get-buffer-create "*SCCS tmp*"))
  895.          (insert-file lock-file)
  896.          (while (search-forward " " () t)
  897.            (replace-match "\n" () t))
  898.          (goto-char (point-min))
  899.          (forward-line 1)
  900.          (let ((revision
  901.             (buffer-substring (point) (progn (end-of-line) (point))))
  902.            (name
  903.             (progn (forward-line 1)
  904.                (buffer-substring (point)
  905.                          (progn (end-of-line) (point))))))
  906.            (kill-buffer (current-buffer))
  907.            (list name revision)))))))
  908.  
  909.  
  910. (defun sccs-do-command (buffer command file &rest flags)
  911.   "Execute an SCCS command, notifying the user and checking for errors."
  912.   (let ((exec-path (cons sccs-bin-directory exec-path)))
  913.     (apply 'sc-do-command buffer command command file (sccs-name file) flags)))
  914.  
  915. (defun sccs-admin (file sid)
  916.   "Checks a file into sccs.
  917. FILE is the unmodified name of the file.  SID should be the base-level sid to
  918. check it in under."
  919.   ;; give a change to save the file if it's modified
  920.   (if (and (buffer-modified-p)
  921.        (y-or-n-p (format "%s has been modified. Write it out? "
  922.                  (buffer-name))))
  923.       (save-buffer))
  924.   (sccs-do-command "*SCCS*" "admin" file
  925.            (concat "-i" file) (concat "-r" sid))
  926.   (sc-chmod "-w" file)
  927.   ;; expand SCCS headers
  928.   (sccs-check-out file nil))
  929.  
  930. (defun sccs-register (file revision)
  931.   (sccs-load-vars)
  932.   (if (and (not (file-exists-p "SCCS"))
  933.        (y-or-n-p "Directory SCCS does not exist, create it?"))
  934.       (make-directory "SCCS"))
  935.   (sccs-admin file
  936.           (cond 
  937.            (revision revision)
  938.            ((error-occurred (load-file "SCCS/emacs-vars.el")) "1")
  939.            (t sccs-current-major-version))))
  940.  
  941. (defun sccs-check-out (file lockp)
  942.   "Retrieve a copy of the latest version of the given file."
  943.   (sccs-do-command "*SCCS*" "get" file (if lockp "-e")))
  944.  
  945. (defun sccs-get-version (file buffer revision)
  946.   (sccs-do-command buffer "get" file
  947.            (and revision (concat "-r" revision))
  948.            "-p" "-s"))
  949.  
  950. (defun sccs-check-in (file revision comment)
  951.   "Check-in a given version of the given file with the given comment."
  952.   (sccs-do-command "*SCCS*" "delta" file "-n"
  953.            (format "-r%s" revision)
  954.            (format "-y%s" comment))
  955.   (sc-chmod "-w" file)
  956.   ;; sccs-delta already turned off write-privileges on the
  957.   ;; file, let's not re-fetch it unless there's something
  958.   ;; in it that get would expand
  959.   (save-excursion
  960.     (let ((buffer (get-file-buffer file)))
  961.       (if buffer
  962.       (progn
  963.         (set-buffer buffer)
  964.         (sccs-check-out file nil))))))
  965.  
  966. (defun sccs-history (file)
  967.   (sccs-do-command (current-buffer) "prs" file))
  968.  
  969. ;; There has *got* to be a better way to do this...
  970.  
  971. (defun sccs-save-vars (sid)
  972.   (save-excursion
  973.     (find-file "SCCS/emacs-vars.el")
  974.     (erase-buffer)
  975.     (insert "(setq sccs-current-major-version \"" sid "\")")
  976.     (basic-save-buffer)))
  977.  
  978. (defun sccs-load-vars ()
  979.   (if (error-occurred (load-file "SCCS/emacs-vars.el"))
  980.       (setq sccs-current-major-version "1")))
  981.  
  982. ;; SCCS header insertion code
  983.  
  984. (defun sccs-insert-headers ()
  985.   "*Insert headers for use with the Source Code Control System.
  986. Headers desired are inserted at the start of the buffer, and are pulled from 
  987. the variable sccs-headers-wanted"
  988.   (interactive)
  989.   (save-excursion
  990.     (save-restriction
  991.       (widen)
  992.       (if (or (not (sccs-check-headers))
  993.           (y-or-n-p "SCCS headers already exist.  Insert another set?"))
  994.       (progn
  995.          (goto-char (point-min))
  996.          (run-hooks 'sccs-insert-headers-hook)
  997.          (cond ((eq major-mode 'c-mode) (sccs-insert-c-header))
  998.            ((eq major-mode 'lisp-mode) (sccs-insert-lisp-header))
  999.            ((eq major-mode 'emacs-lisp-mode) (sccs-insert-lisp-header))
  1000.            ((eq major-mode 'scheme-mode) (sccs-insert-lisp-header))
  1001.            ((eq major-mode 'nroff-mode) (sccs-insert-nroff-header))
  1002.            ((eq major-mode 'plain-tex-mode) (sccs-insert-tex-header))
  1003.            ((eq major-mode 'texinfo-mode) (sccs-insert-texinfo-header))
  1004.            (t (sccs-insert-generic-header))))))))
  1005.  
  1006.  
  1007.  
  1008. (defun sccs-insert-c-header ()
  1009.   (let (st en)
  1010.     (insert "/*\n")
  1011.     (mapcar '(lambda (s)
  1012.            (insert " *\t" s "\n"))
  1013.         sccs-headers-wanted)
  1014.     (insert " */\n\n")
  1015.     (if (and sccs-insert-static 
  1016.          (not (string-match "\\.h$" buffer-file-name)))
  1017.     (progn
  1018.       (insert "#ifndef lint\n"
  1019.           "static char *sccsid")
  1020. ;;      (setq st (point))
  1021. ;;      (insert (file-name-nondirectory buffer-file-name))
  1022. ;;      (setq en (point))
  1023. ;;      (subst-char-in-region st en ?. ?_)
  1024.       (insert " = \"\%\W\%\";\n"
  1025.           "#endif /* lint */\n\n")))
  1026.     (run-hooks 'sccs-insert-c-header-hook)))
  1027.  
  1028. (defun sccs-insert-lisp-header ()
  1029.   (mapcar '(lambda (s) 
  1030.           (insert ";;;\t" s "\n"))
  1031.       sccs-headers-wanted)
  1032.   (insert "\n")
  1033.   (run-hooks 'sccs-insert-lisp-header-hook))
  1034.  
  1035. (defun sccs-insert-nroff-header ()
  1036.   (mapcar '(lambda (s) 
  1037.           (insert ".\\\"\t" s "\n"))
  1038.       sccs-headers-wanted)
  1039.   (insert "\n")
  1040.   (run-hooks 'sccs-insert-nroff-header-hook))
  1041.  
  1042. (defun sccs-insert-tex-header ()
  1043.   (mapcar '(lambda (s) 
  1044.           (insert "%%\t" s "\n"))
  1045.       sccs-headers-wanted)
  1046.   (insert "\n")
  1047.   (run-hooks 'sccs-insert-tex-header-hook))
  1048.  
  1049. (defun sccs-insert-texinfo-header ()
  1050.   (mapcar '(lambda (s) 
  1051.           (insert "@comment\t" s "\n"))
  1052.       sccs-headers-wanted)
  1053.   (insert "\n")
  1054.   (run-hooks 'sccs-insert-texinfo-header-hook))
  1055.  
  1056. (defun sccs-insert-generic-header ()
  1057.   (let* ((comment-start-sccs (or comment-start "#"))
  1058.      (comment-end-sccs (or comment-end ""))
  1059.      (dont-insert-nl-p (string-match "\n" comment-end-sccs)))
  1060.     (mapcar '(lambda (s)
  1061.            (insert comment-start-sccs "\t" s ""
  1062.                comment-end-sccs (if dont-insert-nl-p "" "\n")))
  1063.       sccs-headers-wanted)
  1064.   (insert comment-start-sccs comment-end-sccs (if dont-insert-nl-p "" "\n"))))
  1065.  
  1066. (defun sccs-check-headers ()
  1067.   "Check if the current file has any SCCS headers in it."
  1068.   (save-excursion
  1069.     (goto-char (point-min))
  1070.     (let ((case-fold-search ()))
  1071.       (re-search-forward  "%[MIRLBSDHTEGUYFPQCZWA]%" (point-max) t))))
  1072.  
  1073. (defun sccs-tree-list ()
  1074.   "List all the registered files in the current directory"
  1075.   (call-process "/bin/sh" () t () "-c"
  1076.         (concat "/bin/ls -1 " default-directory "SCCS/s.*"))
  1077.   (goto-char (point-min))
  1078.   (while (search-forward "SCCS/s." () t)
  1079.     (replace-match "" () t)))
  1080.  
  1081. (defun sccs-new-revision-p (file)
  1082.   "True if the SCCS archive is more recent than the file itself"
  1083.   (file-newer-than-file-p (sccs-name file) file))
  1084.  
  1085. (defun sccs-revert (file)
  1086.   "Cancel a check-out and get a fresh copy of the file"
  1087.   (delete-file (sccs-name file "p"))
  1088.   (delete-file file)
  1089.   (sccs-do-command "*SCCS*" "get" file "-s"))
  1090.  
  1091. (defun sccs-rename (old new)
  1092.   "Rename the SCCS archives for OLD to NEW"
  1093.   (if (file-exists-p (sccs-name old "p"))
  1094.       (rename-file (sccs-name old "p") (sccs-name new "p") t))
  1095.   (if (file-exists-p (sccs-name old "s"))
  1096.       (rename-file (sccs-name old "s") (sccs-name new "s") t)))
  1097.  
  1098.  
  1099. ;;; RCS specific part
  1100.  
  1101. ;; Some helper functions
  1102.  
  1103. (defun rcs-name (file)
  1104.   "Return the rcs-file corresponding to a given file."
  1105.   (if (null file)
  1106.       ()
  1107.     (let* ((name (expand-file-name file))
  1108.        (rcs-file (concat name ",v")))
  1109.       (if (and (not (file-exists-p rcs-file))
  1110.            (file-exists-p (concat (file-name-directory name) "RCS")))
  1111.       (setq rcs-file 
  1112.         (format "%sRCS/%s,v" (file-name-directory name)
  1113.             (file-name-nondirectory name))))
  1114.       rcs-file)))
  1115.  
  1116. (defun rcs-lock-info (file)
  1117.   "Lock-info method for RCS.  See sc-generic-lock-info"
  1118.   (let ((rcs-file (rcs-name file))
  1119.     locks-regexp)
  1120.     (if (or (null rcs-file) (not (file-exists-p rcs-file)))
  1121.     ()
  1122.       (save-excursion
  1123.     (set-buffer (get-buffer-create "*RCS tmp*"))
  1124.     (erase-buffer)
  1125.     (call-process "rlog" () t () "-L" "-h" rcs-file)
  1126.     (goto-char (point-min))
  1127.     (if (looking-at "\n.*Working file")
  1128.         ;; RCS 4.x
  1129.         (setq locks-regexp "^locks:")
  1130.       ;; RCS 5.x
  1131.       (setq locks-regexp "^locks:.*$\n"))
  1132.     (if (not (re-search-forward locks-regexp () t))
  1133.         (list () ())
  1134.       (if (not (looking-at (concat "[\t ]*\\([^:]*\\): \\([0-9\\.]*\\)")))
  1135.           (list () ())
  1136.         (list (buffer-substring (match-beginning 1) (match-end 1))
  1137.           (buffer-substring (match-beginning 2) (match-end 2)))))))))
  1138.  
  1139.  
  1140. (defun rcs-register (file revision)
  1141.   (if (and (not (file-exists-p "RCS"))
  1142.        (y-or-n-p "Directory RCS does not exist, create it?"))
  1143.       (make-directory "SCCS"))
  1144.   (sc-do-command "*RCS*" "ci" "ci" file (rcs-name file) "-u"))
  1145.  
  1146. (defun rcs-check-out (file lockp)
  1147.   (sc-do-command "*RCS*" "co" "co" file (rcs-name file) (if lockp "-l")))
  1148.  
  1149. (defun rcs-get-version (file buffer revision)
  1150.   (sc-do-command buffer "co" "co" file (rcs-name file)
  1151.          (if revision (concat "-p" revision) "-p")
  1152.          "-q"))
  1153.  
  1154. (defun rcs-check-in (file revision comment)
  1155.   "Check-in a given version of the given file with the given comment."
  1156.   (sc-do-command "*RCS*" "ci" "ci" file (rcs-name file) "-f"
  1157.          (format "-m%s" comment)
  1158.          (if (equal revision (sc-locked-revision file))
  1159.              "-u"
  1160.            (format "-u%s" revision))))
  1161.  
  1162. (defun rcs-history (file)
  1163.   (sc-do-command (current-buffer) "rlog" "rlog" file (rcs-name file)))
  1164.  
  1165. (defun rcs-tree-list ()
  1166.   "List all the registered files in the current directory"
  1167.   (call-process "/bin/sh" () t () "-c"
  1168.         (concat "/bin/ls -1 " default-directory "RCS/*,v"))
  1169.   (call-process "/bin/sh" () t () "-c"
  1170.         (concat "/bin/ls -1 " default-directory "*,v"))
  1171.   (goto-char (point-min))
  1172.   (while (search-forward "RCS/" () t)
  1173.     (replace-match "" () t))
  1174.   (goto-char (point-min))
  1175.   (while (search-forward ",v" () t)
  1176.     (replace-match "" () t)))
  1177.  
  1178. (defun rcs-new-revision-p (file)
  1179.   "True if the archive is more recent than the file itself"
  1180.   (file-newer-than-file-p (rcs-name file) file))
  1181.  
  1182. (defun rcs-revert (file)
  1183.   "Cancel a check-out and get a fresh copy of the file"
  1184.   (sc-do-command "*RCS*" "rcs" "rcs" file (rcs-name file) "-u")
  1185.   (delete-file file)
  1186.   (sc-do-command "*RCS*" "co" "co" file (rcs-name file)))
  1187.  
  1188. (defun rcs-rename (old new)
  1189.   "Rename the archives for OLD to NEW"
  1190.   (if (file-exists-p (rcs-name old))
  1191.       (rename-file (rcs-name old) (rcs-name new) t)))
  1192.  
  1193.  
  1194. ;;; CVS specific part
  1195.  
  1196. ;;; As we rely on pcl-cvs for the directory level functions the menu is
  1197. ;;; much shorter in CVS mode
  1198.  
  1199.  
  1200. (defun cvs-lock-info (file)
  1201.   "Lock-info method for CVS, different from RCS and SCCS modes.
  1202. File are never locked in CVS."
  1203.   (list () ()))
  1204.  
  1205. (defun cvs-register (file revision)
  1206.   (sc-do-command "*CVS*" "cvs add" cvs-program file
  1207.          (file-name-nondirectory file)
  1208.          "add" "-mInitial revision"))
  1209.  
  1210. (defun cvs-check-out (file lockp)
  1211.   )
  1212.  
  1213. (defun cvs-get-version (file buffer revision)
  1214.   (sc-do-command buffer "cvs update" cvs-program file file "update" 
  1215.          (if revision (concat "-r" revision))
  1216.          "-p" "-q"))
  1217.  
  1218. (defun cvs-check-in (file revision comment)
  1219.   "Check-in a given version of the given file with the given comment."
  1220.   (sc-do-command "*CVS*" "cvs commit" cvs-program file file "commit"
  1221.          (and revision (format "-r%s" revision))
  1222.          (format "-m%s" comment)))
  1223.  
  1224. (defun cvs-history (file)
  1225.   (sc-do-command (current-buffer) "cvs log" cvs-program file file "log"))
  1226.  
  1227. (defun cvs-revert (file)
  1228.   "Cancel a check-out and get a fresh copy of the file"
  1229.   (delete-file file)
  1230.   (sc-do-command "*CVS*" "cvs update" cvs-program file file "update"))
  1231.  
  1232. (defun sc-cvs-update-directory ()
  1233.   "Update the current directory by calling cvs-update from pcl-cvs"
  1234.   (interactive)
  1235.   (cvs-update default-directory))
  1236.  
  1237. (defun sc-cvs-file-status ()
  1238.   "Show the CVS status of the current file"
  1239.   (interactive)
  1240.   (if (not buffer-file-name)
  1241.       (error "There is no file associated with buffer %s" (buffer-name)))
  1242.   (let ((file buffer-file-name))
  1243.     (sc-do-command "*CVS*" "cvs status" cvs-program file file "status" "-v"))
  1244.   (save-excursion
  1245.     (set-buffer "*CVS*")
  1246.     (goto-char (point-min)))
  1247.   (display-buffer "*CVS*"))
  1248.  
  1249.  
  1250. ;;; ClearCase specific part
  1251.  
  1252. (defun ccase-is-registered-3 (fod)
  1253.   (if (or (not fod)
  1254.       (not (file-readable-p fod)))
  1255.       'na
  1256.     (let ((dirs sc-ccase-mfs-prefixes)
  1257.       (f nil)
  1258.       (file (expand-file-name fod)))
  1259.       (while (and (null f) dirs)
  1260.     (if (string-match (car dirs) file)
  1261.         (setq f t)
  1262.       (setq dirs (cdr dirs))))
  1263.       (if (null f)
  1264.       'na
  1265.     (sc-do-command "*CCase*" "describe" "cleartool" fod fod "describe")
  1266.     (save-excursion
  1267.       (set-buffer "*CCase*")
  1268.       (let ((s (buffer-string)))
  1269.         (cond
  1270.          ((string-match "@@" s) t)
  1271.          ((string-match "^Unix" s) 'na)
  1272.          (t nil)
  1273.          )))))))
  1274.  
  1275. (defun ccase-is-registered (fod)
  1276.   (eq (ccase-is-registered-3 fod) t))
  1277.  
  1278. (defun ccase-lock-info (file)
  1279.   (let ((cc (ccase-is-registered-3 file))
  1280.     s)
  1281.     (if (eq cc 't)
  1282.     (progn
  1283.       (save-excursion
  1284.         (set-buffer "*CCase*")
  1285.         (setq s (buffer-string)))
  1286.       (if (string-match "@@[^\n]*CHECKEDOUT\" from \\([^ ]*\\)[^\n]*\n[^\n]* by \\([^(\n]*\\) (" s)
  1287.           (list
  1288.            (substring s (match-beginning 1) (match-end 1))
  1289.            (substring s (match-beginning 2) (match-end 2)))
  1290.         (list nil nil)))
  1291.       cc)))
  1292.  
  1293. (defun ccase-maybe-comment (tag)
  1294.   (if (memq tag sc-ccase-comment-on)
  1295.       (sc-enter-comment)))
  1296.  
  1297. (defun ccase-register (file revision)
  1298.   "Registers the file. We don't support the revision argument.
  1299. Also, we have to checkout the directory first."
  1300.   ;; probably need proper error handling to catch the 
  1301.   ;; cases where we co the directory, but don't get to
  1302.   ;; ci it back (want to uco in this case)
  1303.   (let ((dpath (file-name-directory file)))
  1304.     (if (not (ccase-is-registered dpath))
  1305.     (error "Cannot register file outside of VOB")
  1306.       (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co")
  1307.       (sc-do-command "*CCase*" "register" "cleartool" file file "mkelem")
  1308.       (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci"))))
  1309.  
  1310. (defun ccase-check-out (file lockp)
  1311.   "Checks out the latest version of FILE.  
  1312. If LOCKP is not NIL, FILE is also locked."
  1313.   (let ((comment (ccase-maybe-comment 'checkout)))
  1314.     (sc-do-command "*CCase*" "co" "cleartool" file file "co"
  1315.            (if comment "-c" "-nc")
  1316.            (if comment comment)
  1317.   ;; this locking does not correspond to what we actually want. It's a
  1318.   ;; hack from the days when this was SCCS-only
  1319.            (if (ccase-reserve-p) "-res" "-unr"))
  1320. ))
  1321.  
  1322. (defun ccase-reserve-p ()
  1323.   "Determine whether the user wants a reserved or unreserved checkout"
  1324.   (cond
  1325.    ((eq sc-ccase-reserve t)   t)
  1326.    ((eq sc-ccase-reserve nil) nil)
  1327.    (t (y-or-n-p "Reserve Checkout? "))))
  1328.    
  1329. (defun ccase-get-version (file buffer revision)
  1330.   "Insert a previous revison of FILE in BUFFER.  
  1331. REVISION is the revision number requested."
  1332.   (save-excursion
  1333.     (set-buffer buffer)
  1334.     (delete-region (point-min) (point-max))
  1335.     (insert-file-contents (concat file "@@/" revision)))
  1336. )
  1337.  
  1338. (defun ccase-check-in (file revision message)
  1339.   "Check in FILE with revision REVISION.
  1340. MESSAGE is a string describing the changes."
  1341.   ;; we ignore revision since we can't use it
  1342.   (sc-do-command "*CCase*" "ci" "cleartool" file file "ci" "-c" message (if sc-mode-expert "-ide"))
  1343. )
  1344.  
  1345. (defun ccase-history (file)
  1346.   "Insert the edit history of FILE in the current buffer."
  1347.   (sc-do-command (buffer-name) "history" "cleartool" file file "lsh")
  1348. )
  1349.  
  1350. (defun ccase-tree-list ()
  1351.   "List in the current buffer the files registered in the source control system"
  1352.   ;;; This isn't going to fly as a practicality. We abstract everything out.
  1353.   ;;  (sc-do-command (buffer-name) "listing" "cleartool" (default-directory) (default-directory) "ls" "-r" "-short" "-vis" "-nxname")
  1354. )
  1355.   
  1356. (defun ccase-new-revision-p (file)
  1357.   "True if a new revision of FILE was checked in since we last got a copy of it"
  1358.   (save-excursion
  1359.   (let (pos newfile res br1 br2)
  1360.     (sc-do-command "*CCase*" "Describe" "cleartool" file file "des")
  1361.     (set-buffer "*CCase*")
  1362.     (goto-char (point-min))
  1363.     (if (setq pos (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\" from \\([^ ]*\\) (\\([a-z]*\\))" nil t))
  1364. ;;    (if (setq pos (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\"" nil t))
  1365.     (progn
  1366.       (setq res (buffer-substring (match-beginning 3) (match-end 3)))
  1367.       (if (equal res "unreserved")
  1368.           (progn
  1369.         (setq newfile (concat file "@@"
  1370.                       (buffer-substring (match-beginning 1)
  1371.                             (match-end 1))
  1372.                       "LATEST"))
  1373.         (setq br1 (buffer-substring (match-beginning 2) (match-end 2)))
  1374.         (sc-do-command "*CCase*" "Describe" "cleartool" file newfile
  1375.                    "des")
  1376.         (search-forward-regexp "@@\\([^ \"]*\\)" nil t)
  1377.         (setq br2 (buffer-substring (match-beginning 1) (match-end 1)))
  1378.         (not (equal br1 br2)))
  1379.         nil))
  1380.       (error "%s not currently checked out" file)))))
  1381.  
  1382. (defun ccase-revert (file)
  1383.   "Cancel a check out of FILE and get back the latest checked in version"
  1384.   (sc-do-command "*CCase*" "uco" "cleartool" file file "unco")
  1385. )
  1386.  
  1387. (defun ccase-rename (old new)
  1388.   "Rename the source control archives for OLD to NEW"
  1389.   (let ((dpath (file-name-directory old))
  1390.     (comment (ccase-maybe-comment 'rename)))
  1391.     (if (not (ccase-is-registered dpath))
  1392.     (error "Cannot rename file outside of VOB")
  1393.       (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co"
  1394.            (if comment "-c" "-nc")
  1395.            (if comment comment))
  1396.       (sc-do-command "*CCase*" "mv" "cleartool" new new "mv" 
  1397.            (if comment "-c" "-nc")
  1398.            (if comment comment)
  1399.            old)
  1400.       (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci" 
  1401.              (if comment "-c" "-nc")
  1402.              (if comment comment)))))
  1403.  
  1404. (defun sc-ccase-checkout-dir ()
  1405.   "Checkout the directory this file is in"
  1406.   (interactive)
  1407.   (let ((dpath default-directory)
  1408.     (comment (ccase-maybe-comment 'checkout-dir)))
  1409.     (if (not (ccase-is-registered dpath))
  1410.     (error "Cannot checkout directory outside of VOB")
  1411.       (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co"
  1412.            (if comment "-c" "-nc")
  1413.            (if comment comment)))))
  1414.  
  1415. (defun sc-ccase-checkin-dir ()
  1416.   "Checkin the directory this file is in"
  1417.   (interactive)
  1418.   (let ((dpath default-directory)
  1419.     (comment (ccase-maybe-comment 'checkin-dir)))
  1420.     (if (not (ccase-is-registered dpath))
  1421.     (error "Cannot checkout directory outside of VOB")
  1422.       (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci"
  1423.            (if comment "-c" "-nc")
  1424.            (if comment comment)))))
  1425.  
  1426. (defun sc-ccase-editcs ()
  1427.   "Edit Config Spec for this view"
  1428.   (interactive)
  1429.   (sc-do-command "*CCase-cs*" "catcs" "cleartool" "" nil "catcs")
  1430.   (switch-to-buffer-other-window "*CCase-cs*")
  1431.   (local-set-key "\C-c\C-c" 'exit-recursive-edit)
  1432.   (recursive-edit)
  1433.   (set-buffer "*CCase-cs*")
  1434.   (let ((name (make-temp-name "/tmp/configspec")))
  1435.     (write-region (point-min) (point-max) name)
  1436.     (kill-buffer "*CCase-cs*")
  1437.     (sc-do-command "*CCase*" "setcs" "cleartool" name name "setcs"))
  1438. )
  1439.  
  1440. (defun sc-ccase-new-brtype (brt)
  1441.   "Create a new branch type"
  1442.   (interactive "sBranch Name: ")
  1443.   (let ((comment (ccase-maybe-comment 'new-brtype)))
  1444.     (sc-do-command "*CCase*" "mkbrt" "cleartool" brt brt "mkbrtype"
  1445.            (if comment "-c" "-nc")
  1446.            (if comment comment))))
  1447.  
  1448. (defun sc-ccase-new-branch (brch)
  1449.   "Create a new branch for element"
  1450.   (interactive "sBranch: ")
  1451.   (let ((file (buffer-file-name))
  1452.     (comment (ccase-maybe-comment 'new-branch)))
  1453.     (sc-do-command "*CCase*" "mkbrch" "cleartool" file file "mkbranch" 
  1454.            (if comment "-c" "-nc")
  1455.            (if comment comment)
  1456.            brch)))
  1457.  
  1458. (defun sc-ccase-checkin-merge ()
  1459.   "Merge in changes to enable checkin"
  1460.   (interactive)
  1461.   (save-excursion
  1462.   (let ((file (buffer-file-name))
  1463.     (buf (current-buffer))
  1464.     (comment (ccase-maybe-comment 'checkin-merge)))
  1465.     (sc-do-command "*CCase*" "Describe" "cleartool" file file "des")
  1466.     (set-buffer "*CCase*")
  1467.     (goto-char (point-min))
  1468.     (if (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\" from \\([^ ]*\\) (\\([a-z]*\\))" nil t)
  1469.     (progn
  1470.       (sc-do-command "*CCase*" "Merging" "cleartool" file
  1471.              (concat (buffer-substring (match-beginning 1)
  1472.                            (match-end 1)) "LATEST")
  1473.              "merge"
  1474.              (if comment "-c" "-nc")
  1475.              (if comment comment)
  1476.              "-abort" "-to" file "-ver")
  1477.       (set-buffer buf)
  1478.       (revert-buffer t t)
  1479.       (display-buffer "*CCase*"))
  1480.       (error "File %s not checked out" file)))))
  1481.       
  1482. (defun sc-ccase-version-tree ()
  1483.   "List version tree for file"
  1484.   (interactive)
  1485.   (let ((p (buffer-file-name)))
  1486.     (sc-do-command "*CCase*" "lsvtree" "cleartool" p p "lsvtree")
  1487.     (display-buffer "*CCase*")))
  1488.  
  1489. (defun ccase-protect-expanded-name (revision)
  1490.   "Protect ccase extended names from being used as temp names. Munge /s into :s"
  1491.   (if (equal sc-generic-name "CCase")
  1492.       (progn
  1493.     (if (string-match "/" revision)
  1494.         (let ((str (substring revision 0)) ;; copy string
  1495.           i)
  1496.           (while (setq i (string-match "/" str))
  1497.         (aset str i 58)) ; 58 is for :
  1498.           str)))))
  1499.  
  1500. (defun sc-ccase-list-locked-files ()
  1501.   (interactive)
  1502.   (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "lsco" "-cview"))
  1503.  
  1504. (defun sc-ccase-list-all-locked-files ()
  1505.   (interactive)
  1506.   (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "lsco"))
  1507.  
  1508. (defun sc-ccase-list-registered-files ()
  1509.   "List files registered in clearcase"
  1510.   (interactive)
  1511.   (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "ls" "-r" "-vis" "-nxname"))
  1512.  
  1513. ;;; Instantiation and installation of the menus
  1514.  
  1515. ;;; Set the menubar for Lucid Emacs
  1516. (defvar sc-default-menu
  1517.   '(["NEXT-OPERATION"    sc-next-operation    t    nil]
  1518.     ["Update Current Directory"        sc-update-directory    t]
  1519.     "----"
  1520.     ["Revert File"        sc-revert-file    t    nil]
  1521.     ["Rename File"        sc-rename-this-file        t    nil]
  1522.     "----"
  1523.     ["Show Changes"        sc-show-changes        t]
  1524.     ["Show Changes Since Revision..."    sc-show-revision-changes    t]
  1525.     ["Visit Previous Revision..."    sc-visit-previous-revision    t]
  1526.     ["Show Edit History"        sc-show-history        t]
  1527.     "----"
  1528.     ["List Locked Files"    sc-list-locked-files    t]
  1529.     ["List Locked Files Any User"    sc-list-all-locked-files    t]
  1530.     ["List Registered Files"    sc-list-registered-files    t])
  1531.   "Menubar entry for using the revision control system.")
  1532.  
  1533. (defvar sc-cvs-menu
  1534.   '(["Update Current Directory"        sc-cvs-update-directory    t]
  1535.     ["Revert File"        sc-revert-file    t    nil]
  1536.     "----"
  1537.     ["Show Changes"        sc-show-changes        t]
  1538.     ["Show Changes Since Revision..."    sc-show-revision-changes    t]
  1539.     ["Visit Previous Revision..."    sc-visit-previous-revision    t]
  1540.     ["Show File Status"        sc-cvs-file-status        t]
  1541.     ["Show Edit History"        sc-show-history        t])
  1542.   "Menubar entry for using the revision control system with CVS.")
  1543.  
  1544. (defvar sc-ccase-menu
  1545.   '(["NEXT-OPERATION"            sc-next-operation        t nil]
  1546.     ["Revert File"            sc-revert-file            t nil]
  1547.     ["Checkin Merge"            sc-ccase-checkin-merge      t]
  1548.     "----"
  1549.     ["Show Changes"            sc-show-changes            t]
  1550.     ["Show Changes Since Revision..."    sc-show-revision-changes    t]
  1551.     ["Visit Previous Revision..."    sc-visit-previous-revision    t]
  1552.     ["Show Edit History"        sc-show-history            t]
  1553.     "----"
  1554.     ("Directories" 
  1555.      ["Checkout Directory"        sc-ccase-checkout-dir        t]
  1556.      ["Checkin Directory"        sc-ccase-checkin-dir        t]
  1557.      ["Rename File..."            sc-rename-this-file        t nil])
  1558.     ("Configs"
  1559.      ["Edit Config Spec..."        sc-ccase-editcs            t]
  1560.      ["Create New Branch..."        sc-ccase-new-brtype        t]
  1561.      ["Make New Branch..."        sc-ccase-new-branch        t])
  1562.     ("Listings"
  1563.      ["List Version Tree"        sc-ccase-version-tree        t]
  1564.      ["List Locked Files"        sc-ccase-list-locked-files    t]
  1565.      ["List Locked Files Any User"    sc-ccase-list-all-locked-files    t]
  1566.      ["List Registered Files"        sc-ccase-list-registered-files    t]
  1567.      ))
  1568.   "Menubar entry for using the revision control system.")
  1569.  
  1570. (defun sc-sensitize-menu ()
  1571.   (let* ((rest (cdr (car
  1572.              (find-menu-item current-menubar (list sc-generic-name)))))
  1573.      (case-fold-search t)
  1574.      (file (if buffer-file-name
  1575.            (file-name-nondirectory buffer-file-name)
  1576.          (buffer-name)))
  1577.      (dir (file-name-directory
  1578.            (if buffer-file-name buffer-file-name default-directory)))
  1579.      (lock-info (sc-lock-info buffer-file-name))
  1580.      command
  1581.      nested-rest
  1582.      item)
  1583.     (while rest
  1584.       (setq item (car rest))
  1585.       (if (listp item)
  1586.       (progn
  1587.         (setq nested-rest (cons (cdr rest) nested-rest))
  1588.         (setq rest (cdr item)))
  1589.     (if (vectorp item)
  1590.         (progn
  1591.           (setq command (aref item 1))
  1592.           (cond ((eq 'sc-next-operation command)
  1593.              (aset item 0
  1594.                (cond ((eq lock-info 'na) "Not Available")
  1595.                  ((not lock-info) "Register File")
  1596.                  ((not (car lock-info)) "Check out File")
  1597.                  (t "Check in File")))
  1598.              ;; if locked by somebody else disable the next-operation
  1599.              (if (or (not buffer-file-name)
  1600.                  (eq lock-info 'na)
  1601.                  (and (car lock-info)
  1602.                   (not (equal sc-generic-name "CCase"))
  1603.                   (not (equal (car lock-info) (user-login-name)))))
  1604.              (aset item 2 ())
  1605.                (aset item 2 t)))
  1606.             ((eq lock-info 'na) (aset item 2 ()))
  1607.             ((> (length item) 3)
  1608.              (aset item 3 file))
  1609.             (t nil))
  1610.           (if (not (eq lock-info 'na))
  1611.           (let ((enable-file-items
  1612.              (if (member sc-generic-name '("CVS" "CCase"))
  1613.                  buffer-file-name
  1614.                (if lock-info t ()))))
  1615.             (if (memq command
  1616.                   '(sc-force-check-in-file
  1617.                 sc-register-file
  1618.                 sc-revert-file
  1619.                 sc-rename-this-file
  1620.                 sc-show-history
  1621.                 sc-show-changes
  1622.                 sc-show-revision-changes
  1623.                 sc-visit-previous-revision
  1624.                 sc-cvs-file-status
  1625.                 sc-ccase-checkout-dir
  1626.                 sc-ccase-checkin-dir
  1627.                 sc-ccase-editcs
  1628.                 sc-ccase-new-brtype
  1629.                 sc-ccase-new-branch
  1630.                 sc-ccase-checkin-merge
  1631.                 sc-ccase-needs-merge
  1632.                 sc-ccase-merge-changes
  1633.                 sc-ccase-create-label
  1634.                 sc-ccase-label-sources
  1635.                 sc-ccase-version-tree
  1636.                 sc-list-locked-files
  1637.                 sc-list-all-locked-files
  1638.                 sc-ccase-list-registered-files
  1639.                 ))
  1640.             (aset item 2 enable-file-items))))))
  1641.     (if (not (setq rest (cdr rest)))
  1642.         (if nested-rest
  1643.         (progn
  1644.           (setq rest (car nested-rest))
  1645.           (setq nested-rest (cdr nested-rest)))))))
  1646.     nil))
  1647.  
  1648.  
  1649. ;;; Function to decide which Source control to use
  1650. (defun sc-set-SCCS-mode ()
  1651.   (setq sc-generic-name "SCCS")
  1652.   (setq sc-can-hack-dir t)
  1653.   (setq sc-generic-lock-info 'sccs-lock-info)
  1654.   (setq sc-generic-register 'sccs-register)
  1655.   (setq sc-generic-check-out 'sccs-check-out)
  1656.   (setq sc-generic-get-version 'sccs-get-version)
  1657.   (setq sc-generic-check-in 'sccs-check-in)
  1658.   (setq sc-generic-history 'sccs-history)
  1659.   (setq sc-generic-tree-list 'sccs-tree-list)
  1660.   (setq sc-generic-new-revision-p 'sccs-new-revision-p)
  1661.   (setq sc-generic-revert 'sccs-revert)
  1662.   (setq sc-generic-rename 'sccs-rename)
  1663.   (setq sc-menu
  1664.     (cons (car sc-default-menu)
  1665.           (cons ["Insert Headers"    sccs-insert-headers    t]
  1666.             (cdr sc-default-menu))))
  1667.   (define-key sc-prefix-map "h" 'sccs-insert-headers)
  1668.   (define-key sc-prefix-map "\C-d" 'sc-update-directory))
  1669.  
  1670. (defun sc-set-RCS-mode ()
  1671.   (setq sc-generic-name "RCS")
  1672.   (setq sc-can-hack-dir t)
  1673.   (setq sc-generic-lock-info 'rcs-lock-info)
  1674.   (setq sc-generic-register 'rcs-register)
  1675.   (setq sc-generic-check-out 'rcs-check-out)
  1676.   (setq sc-generic-get-version 'rcs-get-version)
  1677.   (setq sc-generic-check-in 'rcs-check-in)
  1678.   (setq sc-generic-history 'rcs-history)
  1679.   (setq sc-generic-tree-list 'rcs-tree-list)
  1680.   (setq sc-generic-new-revision-p 'rcs-new-revision-p)
  1681.   (setq sc-generic-revert 'rcs-revert)
  1682.   (setq sc-generic-rename 'rcs-rename)
  1683.   (setq sc-menu sc-default-menu)
  1684.   (define-key sc-prefix-map "\C-d" 'sc-update-directory))
  1685.  
  1686. (defun sc-set-CVS-mode ()
  1687.   (require 'pcl-cvs)
  1688.   (setq sc-generic-name "CVS")
  1689.   (setq sc-can-hack-dir t)
  1690.   (setq sc-generic-lock-info 'cvs-lock-info)
  1691.   (setq sc-generic-register 'cvs-register)
  1692.   (setq sc-generic-check-out 'cvs-check-out)
  1693.   (setq sc-generic-get-version 'cvs-get-version)
  1694.   (setq sc-generic-check-in 'cvs-check-in)
  1695.   (setq sc-generic-history 'cvs-history)
  1696.   (setq sc-generic-tree-list 'cvs-tree-list)
  1697.   (setq sc-generic-new-revision-p 'cvs-new-revision-p)
  1698.   (setq sc-generic-revert 'cvs-revert)
  1699.   (setq sc-generic-rename 'cvs-rename)
  1700.   (setq sc-menu sc-cvs-menu)
  1701.   (define-key sc-prefix-map "\C-d" 'sc-cvs-update-directory)
  1702.   (define-key sc-prefix-map "s" 'sc-cvs-file-status))
  1703.  
  1704. (defun sc-set-CLEARCASE-mode ()
  1705.   (setq sc-generic-name "CCase")
  1706.   (setq sc-can-hack-dir nil)
  1707.   (setq sc-generic-lock-info 'ccase-lock-info)
  1708.   (setq sc-generic-register 'ccase-register)
  1709.   (setq sc-generic-check-out 'ccase-check-out)
  1710.   (setq sc-generic-get-version 'ccase-get-version)
  1711.   (setq sc-generic-check-in 'ccase-check-in)
  1712.   (setq sc-generic-history 'ccase-history)
  1713.   (setq sc-generic-tree-list 'ccase-tree-list)
  1714.   (setq sc-generic-new-revision-p 'ccase-new-revision-p)
  1715.   (setq sc-generic-revert 'ccase-revert)
  1716.   (setq sc-generic-rename 'ccase-rename)
  1717.   (setq sc-menu sc-ccase-menu)
  1718.  
  1719.   ;; caching for file directory types
  1720.   (save-excursion
  1721.     (set-buffer (get-buffer-create "*CCase*"))
  1722.     (shell-command-on-region (point-min) (point-max) "df -t mfs | sed -n 's%.*[       ]\\(/[^ ]*\\)$%\\1%p'" t)
  1723.     (goto-char (point-min))
  1724.     (let (x l)
  1725.       (while (condition-case nil (setq x (read (current-buffer)))
  1726.            (error nil))
  1727.     (setq l (cons (prin1-to-string x) l)))
  1728.       (setq sc-ccase-mfs-prefixes (nreverse l))))
  1729. )
  1730.  
  1731. (defun sc-set-ATRIA-mode ()
  1732.   (sc-set-CLEARCASE-mode))
  1733.  
  1734. (defun sc-set-CCASE-mode ()
  1735.   (sc-set-CLEARCASE-mode))
  1736.  
  1737.  
  1738. ;; the module is sucessfully loaded!
  1739. (provide 'generic-sc)
  1740.